perm filename USCSUB.SAI[DOC,TOB] blob sn#227005 filedate 1976-07-20 generic text, type T, neo UTF8
00100	comment convert usc format to su format files;
00200	BEGIN "USC TO SU"
00300	
00400	  EXTERNAL PROCEDURE BAIL;
00500	
00600	  REQUIRE "ABBREV.1D[S1,TOB]" SOURCE_FILE;
00700	  REQUIRE "STD.12H[S1,TOB]" SOURCE_FILE;
00800	  REQUIRE "STD[S1,TOB]" LOAD_MODULE;
00900	
01000	  REQUIRE "FILEIO.2E[S2,TOB]" SOURCE_FILE;
01100	  REQUIRE "FILEIO[S2,TOB]" LOAD_MODULE;
01200	
     

00100	
00200	RECORD_POINTER (IO) IFILE; comment input file, channel,etc;
00300	RECORD_POINTER (IO) OFILE;  comment output file,channel,etc;
00400	STRING NAME; comment file name;
00500	BAIL;
00600	END "USC TO SU";
00700	IFCR 0 THENC
00800	NAME←ASK_STRING(CRLF&"FILE NAME ");
00900	NEWFILE(IFILE,NAME,"USC","PIC,HE");
01000	OPEN_I(IFILE,BINARY_FILE);
01100	NEWFILE(OFILE,NAME,"SU","PIC,HE");
01200	OPEN_O(OFILE,BINARY_FILE);
01300	BEGIN "HEADER"
01400	INTEGER UNPACKED;  comment nonzero if file is unpacked;
01500	INTEGER BITS,BYTES;
01600	INTEGER X1,Y1,X2,Y2;
01700	INTEGER WDS_LINE,SIZE_FILE;
01800	INTEGER I;
01900	BITS←8;
02000	X1←Y1←1;
02100	X2←Y2←512;
02200	WRITE(BITS);WRITE(X1);WRITE(X2);WRITE(Y1);WRITE(Y2);
02300	MODIFY(X2);
02400	PRINT(CRLF,"USC files are usually packed 4 bytes per word.");
02500	PRINT(CRLF,"If unpacked, two bytes per word.");
02600	UNPACKED←YES(CRLF&"Is this unpackedα);
02700	WORDOUT(IO:CH[OFILE],-1); comment first word identifier;
02800	WORDOUT(IO:CH[OFILE],BITS);comment number of bits;
02900	BYTES←WORD_SIZE%BITS;comment bytes per word;
03000	WDS_LINE←(X2-X1+BYTES)%BYTES;
03100	WORDOUT(IO:CH[OFILE],WDS_LINE);
03200	WORDOUT(IO:CH[OFILE],Y1);
03300	WORDOUT(IO:CH[OFILE],Y2);
03400	WORDOUT(IO:CH[OFILE],X1);
03500	WORDOUT(IO:CH[OFILE],X2);
03600	SIZE_FILE←WDS_LINE*(Y2-Y1+1);
03700	WORDOUT(IO:CH[OFILE],XWD(-SIZE_FILE,'200));
03800	FOR I←1 STEP 1 UNTIL 3 DO WORDOUT(IO:CH[OFILE],0);
03900	FOR I←'13 STEP 1 UNTIL '177 DO WORDOUT(IO:CH[OFILE],0);
04000	IF ¬UNPACKED THEN
04100	  INOUT(IO:CH[IFILE],IO:CH[OFILE],SIZE_FILE);
04200	IF UNPACKED THEN BEGIN "PACKW"
04300	  INTEGER X,Y; comment indices;
04400	  FOR Y←Y1 STEP 1 UNTIL Y2 DO BEGIN "ROW"
04500	    FOR X←X1 STEP 4 UNTIL X2 DO BEGIN "COLUMN"
04600	      INTEGER W;  comment input word;
04700	      INTEGER WO; comment packed output word;
04800	
04900	      W←WORDIN(IO:CH[IFILE]);
05000	      comment get the first two bytes w=0,b1,0,b2,0;
05100	      WO←((W LAND 001774000000) LSH 8)
05200	        +((W LAND 000003770000) LSH 16);
05300	       W←WORDIN(IO:CH[IFILE]);
05400	       comment get the next two bytes w=0,b3,0,b4,0;
05500	       WO←WO+((W LAND 001774000000) LSH -8)
05600	         +((W LAND 000003770000);
05700	      WORDOUT(IO:CH[OFILE],WO);
05800	      END "COLUMN";
05900	    END "ROW";
06000	  END "PACKW";
06100	  CLOSE(IO:CH[OFILE]);
06200	END "USC TO SU";
06300	ENDC;